home *** CD-ROM | disk | FTP | other *** search
/ IRIX 5.3 for Indy R4400 / IRIX 5.3 for Indy R4400 175MHz.img / dist / eoe2.idb / usr / lib / perl / pwd.pl.z / pwd.pl
Perl Script  |  1995-02-28  |  2KB  |  82 lines

  1. ;# pwd.pl - keeps track of current working directory in PWD environment var
  2. ;#
  3. ;# $RCSfile: pwd.pl,v $$Revision: 1.4 $$Date: 1993/08/13 18:45:11 $
  4. ;#
  5. ;# $Log: pwd.pl,v $
  6. #Revision 1.4  1993/08/13  18:45:11  cwilson
  7. #@#!@#$! rcs that thinks it knows the comment character from the suffix.
  8. #
  9. # Revision 1.3  1993/08/13  18:38:58  cwilson
  10. # comment problem revisited
  11. #
  12. ;# Revision 1.2  1993/07/06  20:48:40  cwilson
  13. ;# stupid comment problem
  14. ;#
  15. ;# Revision 1.1  1993/05/14  19:52:16  cwilson
  16. ;# Initial revision
  17. ;#
  18. ;# Revision 4.0.1.1  92/06/08  13:45:22  lwall
  19. ;# patch20: support added to pwd.pl to strip automounter crud
  20. ;# 
  21. ;# Revision 4.0  91/03/20  01:26:03  lwall
  22. ;# 4.0 baseline.
  23. ;# 
  24. ;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
  25. ;# patch42: some .pl files were missing their trailing 1;
  26. ;# 
  27. ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
  28. ;# patch19: Initial revision
  29. ;# 
  30. ;#
  31. ;# Usage:
  32. ;#    require "pwd.pl";
  33. ;#    &initpwd;
  34. ;#    ...
  35. ;#    &chdir($newdir);
  36.  
  37. package pwd;
  38.  
  39. sub main'initpwd {
  40.     if ($ENV{'PWD'}) {
  41.     local($dd,$di) = stat('.');
  42.     local($pd,$pi) = stat($ENV{'PWD'});
  43.     if ($di != $pi || $dd != $pd) {
  44.         chop($ENV{'PWD'} = `pwd`);
  45.     }
  46.     }
  47.     else {
  48.     chop($ENV{'PWD'} = `pwd`);
  49.     }
  50.     if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) {
  51.     local($pd,$pi) = stat($2);
  52.     local($dd,$di) = stat($1);
  53.     if ($di == $pi && $dd == $pd) {
  54.         $ENV{'PWD'}="$2$3";
  55.     }
  56.     }
  57. }
  58.  
  59. sub main'chdir {
  60.     local($newdir) = shift;
  61.     if (chdir $newdir) {
  62.     if ($newdir =~ m#^/#) {
  63.         $ENV{'PWD'} = $newdir;
  64.     }
  65.     else {
  66.         local(@curdir) = split(m#/#,$ENV{'PWD'});
  67.         @curdir = '' unless @curdir;
  68.         foreach $component (split(m#/#, $newdir)) {
  69.         next if $component eq '.';
  70.         pop(@curdir),next if $component eq '..';
  71.         push(@curdir,$component);
  72.         }
  73.         $ENV{'PWD'} = join('/',@curdir) || '/';
  74.     }
  75.     }
  76.     else {
  77.     0;
  78.     }
  79. }
  80.  
  81. 1;
  82.